www.gusucode.com > 忠网网站广告管理系统 ZonGG V1.3 > 忠网网站广告管理系统 ZonGG V1.3\code\include\Function.asp
<%
'///******************************************************************
' 系统内通用函数 文件名：Function.asp
'******************************************************************///
%>
<!-- #INCLUDE FILE="PubFunction.asp" -->
<!-- #INCLUDE FILE="IncHeads.asp" -->
<%
'' 广告位类型
Const Ggweilx="|固定位置循环|竖直方向排列|水平方向排列|竖直方向滚动|水平方向滚动|依次循环弹出|"
Const ErrSucTs="<table border=1 width=450 cellspacing=0 cellpadding=2 bordercolorlight=#C0C0C0 bordercolordark=#FFFFFF>"
Const xsleicnlb="图片|动画|纯文本|嵌入代码|植入网页" '' 广告条显示类型中文标识
Const xsleienlb="tp|dh|wb|dm|wy" '' 广告条显示类型英文标识
'//********************************************************************
' Ggacts(shu) 广告状态显示 / 参数：shu 表示广告状态的数字 有返回值
'********************************************************************//
Function Ggacts(shu)
Ggacts=""
Select case shu
case 1:Ggacts="正常"
case 0:Ggacts="暂停"
case 2:Ggacts="失效"
end select
end Function
'/********************************************************************
' GgwXsfsClass(shu) 广告位类型下拉菜单 / 参数：shu 表示类型的数字
'********************************************************************/
Sub GgwXsfsClass(shu)
if isnumeric(shu)=false then shu=1
Response.write "<select size=1 name=Plei>"
Ggweilxs=split(Ggweilx,"|")
For i=1 To Ubound(Ggweilxs)-1
Response.write " <option value="&i
if shu=i then Response.write " selected"
Response.write ">"&Ggweilxs(i)&"</option>"
next
Response.write "</select>"
end sub
'/********************************************************************
' GgwSelect(cid) 广告分类下拉菜单 参数： cid 表示选中的分类编号
'********************************************************************/
Sub GgwSelect(cid)
if isnumeric(cid)=false then cid=1
Response.write "<select name=cid size=1>"
Set RsLs=Server.CreateObject("ADODB.Recordset")
RsLs.Open "select cid,cname from class",conn,1,1
do while not RsLs.eof
IF AdminClassIfkg(RsLs(0))="yes" then '' 如果属所管 则显示
response.write "<option value='"&int(RsLs(0))&"'"
if cid=int(RsLs(0)) then response.write " selected"
response.write ">"&RsLs(1)&"</option>"
END IF
RsLs.movenext
loop
RsLs.Close
Set RsLs=Nothing
response.write "<option value='0'>分类备用箱</option>"
Response.write "</select>"
end Sub
'/********************************************************************
' GgwClassSelect(pids) 广告分类与广告位下拉菜单（可多选） 参数：pid 选中的广告位编号列表
'********************************************************************/
Sub GgwClassSelect(pids)
Response.write "<select name=place size=8 multiple>"
response.write "<option value='x'>--------- 可以同时选择显示于多个广告位 ---------</option>"
Set RsLs=Server.CreateObject("ADODB.Recordset") '开始广告分类循环
RsLs.Open "select cid,cname from class ",conn,1,1
do while not RsLs.eof
IF AdminClassIfkg(RsLs(0))="yes" then '' 如果属所管 则显示
response.write "<option value='x'>╋ "&RsLs(1)&"</option>"
Set RsLs1=Server.CreateObject("ADODB.Recordset") '开始广告位循环
RsLs1.Open "select Pid,Pname from place where cid="&RsLs(0),conn,1,1
do while not RsLs1.eof
response.write "<option value='"&RsLs1(0)&"'"
if instr(","&pids&",",","&RsLs1(0)&",")>0 then response.write " selected"
response.write ">┣ "&RsLs1(1)&"</option>"
RsLs1.movenext
loop
RsLs1.Close
END IF
RsLs.movenext
loop
RsLs.Close
Set RsLs=Nothing
IF AdminClassIfkg("all")="yes" then '' 如果属总管 则显示备用箱
response.write "<option value='x'>╋ 备用广告位</option>"
Set RsLs1=Server.CreateObject("ADODB.Recordset") '开始广告位循环
RsLs1.Open "select Pid,Pname from place where cid=0",conn,1,1
do while not RsLs1.eof
response.write "<option value='"&RsLs1(0)&"'"
if instr(","&pids&",",","&RsLs1(0)&",")>0 then response.write " selected"
response.write ">┣ "&RsLs1(1)&"</option>"
RsLs1.movenext
loop
RsLs1.Close
END IF
response.write "<option value='x'>--------- 可以同时选择显示于多个广告位 ---------</option>"
Response.write "</select>"
end Sub
'/********************************************************************
' GgwClassSelect1(pids) 广告分类与广告位下拉菜单（不可多选） 参数：pid 选中的广告位编号列表
'********************************************************************/
Sub GgwClassSelect1(pids)
Response.write "<select name=place size=1>"
response.write "<option value='x'>--- 请选择有效广告位 ---</option>"
Set RsLs=Server.CreateObject("ADODB.Recordset") '开始广告分类循环
RsLs.Open "select cid,cname from class ",conn,1,1
do while not RsLs.eof
response.write "<option value='x'>╋ "&RsLs(1)&"</option>"
Set RsLs1=Server.CreateObject("ADODB.Recordset") '开始广告位循环
RsLs1.Open "select Pid,Pname from place where cid="&RsLs(0),conn,1,1
do while not RsLs1.eof
response.write "<option value='"&RsLs1(0)&"'"
if instr(","&pids&",",","&RsLs1(0)&",")>0 then response.write " selected"
response.write ">┣ "&RsLs1(1)&"</option>"
RsLs1.movenext
loop
RsLs1.Close
RsLs.movenext
loop
RsLs.Close
Set RsLs=Nothing
IF AdminClassIfkg("all")="yes" then '' 如果属总管 则显示备用箱
response.write "<option value='x'>╋ 备用广告位</option>"
Set RsLs1=Server.CreateObject("ADODB.Recordset") '开始广告位循环
RsLs1.Open "select Pid,Pname from place where cid=0",conn,1,1
do while not RsLs1.eof
response.write "<option value='"&RsLs1(0)&"'"
if instr(","&pids&",",","&RsLs1(0)&",")>0 then response.write " selected"
response.write ">┣ "&RsLs1(1)&"</option>"
RsLs1.movenext
loop
RsLs1.Close
END IF
Response.write "</select>"
end Sub
'/***********************************************************************
' 权限标识组织
' 分割模式： 管理员设置,广告图管理,分类进行管理类型#分类1,分类2,分类3,...
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' AdminQx(nl,cid) 管理员权限判断 / 参数：nl 要进入哪类管理
' nl=1 >> 管理员设置、nl=2 >> 广告图管理、nl=3 >> 分类进行管理类型
' 如果 nl=1 则判断 管理员设置 是否 为 1,不是1则权限不足
' 如果 nl=2 则判断 广告图管理 是否 为 1,不是1则权限不足
' 如果 nl=3 则判断 广告图管理 是否 为 1,为0时权限不足，为1时包含全部分
' 类权限，为2时 判断 cid 是否 在 分类列表中存在 如果不存在则权限不足
'***********************************************************************/
Sub AdminQx(nl,cid)
Dim qxbz:qxbz="yes" ' 默认为权限不足
qxbs=PubFgdy(Session("ZonGGadminqx"),"#",0)
cids=PubFgdy(Session("ZonGGadminqx"),"#",1)
Select Case nl
Case 1
if PubFgdy(qxbs,",",0)="1" then qxbz="no"
Case 2
if PubFgdy(qxbs,",",1)="1" then qxbz="no"
Case 3
Select Case PubFgdy(qxbs,",",2)
Case "0":qxbz="yes"
Case "1":qxbz="no"
Case "2"
if instr(","&cids&",",","&cid&",")>0 then qxbz="no"
End Select
End Select
If qxbz="yes" Then '' 如果权限不足 则给出提示
Response.write "<script language=""javascript"">"
Response.write "alert(""对不起您的权限不足，无法继续此操作！\n\n可能原因有：\n\n"&_
"1.未被授权时新增分类、管理备用箱、管理广告图\n\n"&_
"2.点击了没有管理权限的分类操作（独立显示、清理、新增广告位等）\n\n"&_
"3.更改广告位属性时将所属分类选中了没有管理权限的分类名\n\n"&_
"4.试图管理未被授权分类的广告位、广告条\n\n"&_
"5.试图未被授权时设置管理员（查看已有管理员、新增管理员等）\n\n"&_
""");"
Response.write "history.back(1);"
Response.write "</script>"
response.end
End if
end sub
'/********************************************************************
' AdminIfzg() 判断当前管理员是否为分类、广告位总管
'********************************************************************/
Function AdminIfzg()
AdminIfzg="no"
if PubFgdy(PubFgdy(Session("ZonGGadminqx"),"#",0),",",2)="1" then AdminIfzg="yes"
end Function
'/********************************************************************
' AdminClassIfkg(cid) 判断某分类是否属当前管理员所管 参数：cid 分类id
'********************************************************************/
Function AdminClassIfkg(cid)
AdminClassIfkg="no"
qxbs=PubFgdy(Session("ZonGGadminqx"),"#",0)
cids=PubFgdy(Session("ZonGGadminqx"),"#",1)
Select Case PubFgdy(qxbs,",",2)
Case "0":AdminClassIfkg="no"
Case "1":AdminClassIfkg="yes"
Case "2"
if instr(","&cids&",",","&cid&",")>0 then AdminClassIfkg="yes"
End Select
end Function
'/********************************************************************
' GGtiaoxxRuku() 添加广告条信息入库过程
'********************************************************************/
Sub GGtiaoxxRuku()
Dim ADid,getname,ipkg,geturl,getgif,getplace,getwin,getxslei,getclass,getclicks,getshows,gettime,getintro,gethei,getwid,Picid,getcss
getname = Trim(Request("name"))
geturl = Trim(Request("url"))
getgif = Trim(Request("gif_url"))
getplace = Replace(Replace(Replace(Replace(trim(Request("place")),",x",""),",x","")," ",""),",,",",")
getplace = Replace(getplace,",x","")
getplace = Replace(getplace,"x,","")
getwin =trim(Request("window"))
getxslei = trim( Request( "xslei" ))
getclass=trim(Request("class"))
getintro=trim(Request("intro"))
getcss=REPLACE(trim(request("ADcss")),", ",",")&","&trim(request("ADcss1"))&","&trim(request("ADcss2"))&","&trim(request("ADcss3"))
ipkg=cint(trim(request("ipkg")))
if getxslei="txt" then
getwid=0
gethei=0
end if
if getclass=0 then
getclicks=0
getshows=0
gettime=now()
elseif getclass=1 then
getclicks=trim(request("clicks1"))
getshows=0
gettime=now()
elseif getclass=2 then
getclicks=0
getshows=trim(request("shows2"))
gettime=now()
elseif getclass=3 then
getclicks=0
getshows=0
gettime=trim(request("time3"))
elseif getclass=4 then
getclicks=trim(request("clicks4"))
getshows=trim(request("shows4"))
gettime=now()
elseif getclass=5 then
getclicks=trim(request("clicks5"))
getshows=0
gettime=trim(request("time5"))
elseif getclass=6 then
getclicks=0
getshows=trim(request("shows6"))
gettime=trim(request("time6"))
elseif getclass=7 then
getclicks=trim(request("clicks7"))
getshows=trim(request("shows7"))
gettime=trim(request("time7"))
end if
Picid=PicNewRuku(getgif) '新增或修改广告图片URL记录 （自动判断）
'' 如果不为图片合动画类型 则 Picid 和 Picurl 与 广告条关联 不做关联
if getxslei<>"tp" and getxslei<>"dh" then
Picid=0
getgif="http://"
end if
Sql="select * from Advertisement"
Rs.open Sql,Conn,1,3
Rs.AddNew
Rs("Picid") = Picid
Rs("ADact") = 1
Rs("ADname") = getname
Rs("ADurl") = geturl
Rs("Pids") = getplace
Rs("ADxslei") = getxslei
Rs("ADwindow") = getwin
Rs("ADclass") = getclass
Rs("ADclicks") = getclicks
Rs("ADshows") = getshows
Rs("ADstoptime") = gettime
Rs("ADstarttime") = Now()
Rs("ADtime") = now()
Rs("ADintro")=getintro
Rs("ADcss")=getcss
Rs("Picurl")=getgif
Rs("ADipkg")=ipkg
Rs.update
ADid=Rs(0)
if xmltype=1 then ''
if PubSetFolder(dataxml&"/Advertisement/"&Rs(0))="Suc" then '如果建立 ADid 目录 成功
call PubCopyFile(dataxml&"/adv.xml",dataxml&"/Advertisement/"&Rs(0)&"/adv.xml") '建立 adv.xml 文件
'' 循环得到子节点编号列表
'' 循环得到符值列表
Dim tes,sits:tes=rs(0):sits="0"
For i=1 to 19
tes=tes&"/$/"&rs(i)
sits=sits&"|"&i
Next
call PubEditXml(dataxml&"/Advertisement/"&Rs(0)&"/adv.xml","Advertisement",sits,tes) '为 adv.xml 文件设置内容
call PubCopyFile(dataxml&"/ip1.xml",dataxml&"/Advertisement/"&Rs(0)&"/ip1.xml") '建立 ip1.xml 文件
call PubCopyFile(dataxml&"/ip2.xml",dataxml&"/Advertisement/"&Rs(0)&"/ip2.xml") '建立 ip2.xml 文件
end if
end if
Rs.close
'' 将广告ID循环插入显示广告位
Dim xhggws,ggws
xhggws=split(getplace&",",",")
for i=0 to Ubound(xhggws)-1
if isnumeric(xhggws(i)) then
rs.open "select ADids,Pname from place where Pid="&cint(xhggws(i)),conn,3,3,1
if len(trim(rs(0)))>0 then
if instr(","&rs(0)&",",","&ADid&",")=0 then
rs(0)=rs(0)&","&ADid
rs.update
end if
else
rs(0)=ADid
rs.update
end if
if xmltype=1 then ''
call PubEditXml(dataxml&"/place/"&xhggws(i)&".xml","Place","5",Rs(0)) '为 placeid.xml 文件设置内容
end if
rs.close
end if
next
response.write ErrSucTs&"<tr><td height=30>已成功添加了一个广告条：<font class=red>"&getname&"</font>，广告ID：<font class=red>"&ADid&"</font></td></tr><tr><td height=100>"
response.write " <font class=red>>>></font> 该广告条将显示于下列广告位<br>"
For i=0 To Ubound(xhggws)-1
response.write " <font class=red> "&i+1&". </font>"&Ggwm(xhggws(i))&" <font class=red>ID="&xhggws(i)&"</font><br>"
next
response.write " <p align=center>[<a href='GGtiao.asp?'>返回列表</a>] [<a href='#' onclick=javascript:opw('GGtiaoCz.asp?a=Yl&id="&ADid&"','banner',800,600)>打开预览</a>] [<a href='GGtiaoNew.asp'>继续新增</a>]<br><br></p></td></tr></table>"
'if trim(request.querystring("id"))<>"" and isnumeric(Picid)=true and isnumeric(trim(request.querystring("id")))=True then
'Call PicOldRuku(getgif,Picid) '修改或新增广告图片URL记录
'end if
End Sub
'/********************************************************************
' GGtiaoxxEditRuku(id) 修改广告条信息入库过程 参数：id 广告条iD
'********************************************************************/
Sub GGtiaoxxEditRuku(id)
if isnumeric(id)=false then exit sub
Rs.open "select * from Advertisement where ADid="&Cint(id),conn,3,3,1
if not rs.eof then '如果广告条确实存在则 继续 修改
Dim ADid,getname,ipkg,getplace1,geturl,getgif,getplace,getwin,getxslei,getclass,getclicks,getshows,gettime,getintro,Picid,getcss
getname = Trim(Request("name"))
geturl = Trim(Request("url"))
getgif = Trim(Request("gif_url"))
getplace = Replace(Replace(Replace(Replace(trim(Request("place")),"x,",""),",x","")," ",""),",,",",")
getplace = Replace(getplace,",x","")
getplace = Replace(getplace,"x,","")
getwin =trim(Request("window"))
getxslei = trim( Request( "xslei" ))
getclass=trim(Request("class"))
getintro=trim(Request("intro"))
getcss=REPLACE(trim(request("ADcss")),", ",",")&","&trim(request("ADcss1"))&","&trim(request("ADcss2"))&","&trim(request("ADcss3"))
ipkg=cint(trim(request("ipkg")))
getplace1=rs("Pids")
if getclass=0 then
getclicks=0
getshows=0
gettime=now()
elseif getclass=1 then
getclicks=trim(request("clicks1"))
getshows=0
gettime=now()
elseif getclass=2 then
getclicks=0
getshows=trim(request("shows2"))
gettime=now()
elseif getclass=3 then
getclicks=0
getshows=0
gettime=trim(request("time3"))
elseif getclass=4 then
getclicks=trim(request("clicks4"))
getshows=trim(request("shows4"))
gettime=now()
elseif getclass=5 then
getclicks=trim(request("clicks5"))
getshows=0
gettime=trim(request("time5"))
elseif getclass=6 then
getclicks=0
getshows=trim(request("shows6"))
gettime=trim(request("time6"))
elseif getclass=7 then
getclicks=trim(request("clicks7"))
getshows=trim(request("shows7"))
gettime=trim(request("time7"))
end if
Picid=PicNewRuku(getgif) '新增或修改广告图片URL记录 （自动判断）
'' 如果不为图片合动画类型 则 Picid 和 Picurl 与 广告条关联 不做关联
if getxslei<>"tp" and getxslei<>"dh" then
Picid=0
getgif="http://"
end if
Rs("Picid") = Picid
Rs("ADname") = getname
Rs("ADurl") = geturl
Rs("Pids") = getplace
Rs("ADxslei") = getxslei
Rs("ADwindow") = getwin
Rs("ADclass") = getclass
Rs("ADclicks") = getclicks
Rs("ADshows") = getshows
Rs("ADstoptime") = gettime
Rs("ADintro")=getintro
Rs("ADcss")=getcss
Rs("Picurl")=getgif
Rs("ADipkg")=ipkg
Rs.update
ADid=Rs(0)
if xmltype=1 then ''
'' 循环得到子节点编号列表
'' 循环得到符值列表
Dim tes,sits:tes=rs(0):sits="0"
For i=1 to 19
tes=tes&"/$/"&rs(i)
sits=sits&"|"&i
Next
call PubEditXml(dataxml&"/Advertisement/"&Rs(0)&"/adv.xml","Advertisement",sits,tes) '重新设置 adv.xml
end if
end if
Rs.close
'' 将广告ID循环从原显示的各广告位移出
Dim xhggws1,ggws1
xhggws1=split(getplace1&",",",")
for i=0 to Ubound(xhggws1)-1
if isnumeric(xhggws1(i)) then
'' 如果原广告位id在新广告位ID列表中存在 ,
'' 如果不存在则继续执行移出操作，将广告条id从原广告位中移出
if instr(","&getplace&",",","&xhggws1(i)&",")=0 then
rs.open "select ADids from place where Pid="&cint(xhggws1(i)),conn,3,3,1
if not rs.eof then
if instr(rs(0),",")>0 then
if instr(rs(0),ADid&",")>0 then
rs(0)=replace(rs(0),ADid&",","")
rs.update
else
rs(0)=replace(rs(0),","&ADid,"")
rs.update
end if
else
rs(0)=""
rs.update
end if
if xmltype=1 then ''
call PubEditXml(dataxml&"/place/"&xhggws1(i)&".xml","Place","5",Rs(0)) '为 placeid.xml 文件 ADids 设置新内容
end if
end if
rs.close
end if
end if
next
'' 将广告ID循环插入显示广告位
'conn.execute("update Place set ADids='"&ADids&"' where Pid="&Pid)
Dim xhggws,ggws
xhggws=split(getplace&",",",")
for i=0 to Ubound(xhggws)-1
if isnumeric(xhggws(i)) then
'' 如果新广告位id在原广告位ID列表中不存在 ,
if instr(","&getplace1&",",","&xhggws(i)&",")=0 then
response.write xhggws(i)
rs.open "select ADids,Pname from place where Pid="&cint(xhggws(i)),conn,3,3,1
if len(rs(0))>0 then
rs(0)=rs(0)&","&ADid
rs.update
else
rs(0)=ADid
rs.update
end if
if xmltype=1 then ''
call PubEditXml(dataxml&"/place/"&xhggws(i)&".xml","Place","5",Rs(0)) '为 placeid.xml 文件 ADids 设置内容
end if
rs.close
end if
end if
next
response.write ErrSucTs&"<tr><td height=30>已成功修改了一个广告条：<font class=red>"&getname&"</font>，广告ID：<font class=red>"&ADid&"</font></td></tr><tr><td height=100>"
response.write " <font class=red>>>></font> 该广告条将显示于下列广告位<br>"
For i=0 To Ubound(xhggws)-1
response.write " <font class=red> "&i+1&". </font>"&Ggwm(xhggws(i))&" <font class=red>ID="&xhggws(i)&"</font><br>"
next
response.write " <p align=center>[<a href='GGtiao.asp?'>返回列表</a>] [<a href='#' onclick=javascript:opw('GGtiaoCz.asp?a=Yl&id="&ADid&"','banner',800,600)>打开预览</a>] [<a href='GGtiaoEdit.asp?id="&ADid&"'>重新修改</a>]<br><br></p></td></tr></table>"
''
End Sub
'//********************************************************************
' GgtiaoWH(id) 广告条显示定义宽高函数 仅用于定义弹出窗口高宽 参数：id 广告条iD
'********************************************************************//
Function GgtiaoWH(id)
GgtiaoWH=""
if isnumeric(id)=false then exit function
if xmltype=1 then ''
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML1.load(Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADcss1=xml1.childNodes.item(17).text
Set xml1=nothing
Set objXML1 =nothing
else
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,1,1
if not tempRs.eof then
ADcss1 = tempRs(17)
end if
tempRs.close
Set tempRs=nothing
end if
GgtiaoWH="width="&PubFgdy(ADcss1,",",1)&",height="&PubFgdy(ADcss1,",",0)
End Function
'/********************************************************************
' GgtiaoDelete(id,pids) 删除某广告条 参数：id 广告条iD ,pids 要从哪些广告位中移出该广告条
'********************************************************************/
Sub GgtiaoDelete(id,pids)
if isnumeric(id) then
if xmltype=1 then ''
if PubDeleteFolder(dataxml&"/Advertisement/"&id&"")="Suc" then
conn.execute("delete from Advertisement where ADid="&id)
''
'' 如果 pids<>"" 执行与所属各广告位关联的取消操作
''
if pids<>"" then
'' 将广告ID循环从选中的各广告位移出，同时将选中的广告位ID从 Pids 中移出
'' Dim GgtiaoDelPidss
GgtiaoDelPidss=split(pids&",",",")
for i=0 to Ubound(GgtiaoDelPidss)-1
if isnumeric(GgtiaoDelPidss(i)) then
rs.open "select ADids from place where Pid="&cint(GgtiaoDelPidss(i)),conn,3,3,1
if not rs.eof then
if instr(rs(0),",")>0 then
if instr(rs(0),id&",")>0 then
rs(0)=replace(rs(0),id&",","")
rs.update
else
rs(0)=replace(rs(0),","&id,"")
rs.update
end if
else
rs(0)=""
rs.update
end if
call PubEditXml(dataxml&"/place/"&GgtiaoDelPidss(i)&".xml","Place","5",Rs(0)) '为 placeid.xml 文件 ADids 设置新内容
end if
rs.close
end if
next
end if
end if
else
conn.execute("delete from Advertisement where ADid="&id)
''
'' 如果 pids<>"" 执行与所属各广告位关联的取消操作
''
if pids<>"" then
'' 将广告ID循环从选中的各广告位移出，同时将选中的广告位ID从 Pids 中移出
'' Dim GgtiaoDelPidss
GgtiaoDelPidss=split(pids&",",",")
for i=0 to Ubound(GgtiaoDelPidss)-1
if isnumeric(GgtiaoDelPidss(i)) then
rs.open "select ADids from place where Pid="&cint(GgtiaoDelPidss(i)),conn,3,3,1
if not rs.eof then
if instr(rs(0),",")>0 then
if instr(rs(0),id&",")>0 then
rs(0)=replace(rs(0),id&",","")
rs.update
else
rs(0)=replace(rs(0),","&id,"")
rs.update
end if
else
rs(0)=""
rs.update
end if
end if
rs.close
end if
next
end if
end if
end if
End Sub
'//********************************************************************
' GgtiaoWH7(id) 浮动广告条显示定义宽高函数 仅用于定义弹出窗口高宽 参数：id 广告条iD
'********************************************************************//
Function GgtiaoWH7(id)
GgtiaoWH7=""
if isnumeric(id)=false then exit function
if xmltype=1 then ''
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML1.load(Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADcss1=xml1.childNodes.item(17).text
Set xml1=nothing
Set objXML1 =nothing
else
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,1,1
if not tempRs.eof then
ADcss1 = tempRs(17)
end if
tempRs.close
Set tempRs=nothing
end if
GgtiaoWH7=" style=\""height:"&PubFgdy(ADcss1,",",0)&"px; width:"&PubFgdy(ADcss1,",",1)&"px\"" "
End Function
'/********************************************************************
' GgtiaoCss(id) 广告条样式调用函数 参数：id 广告条iD
'********************************************************************/
Function GgtiaoCss(id)
if isnumeric(id)=false then
GgtiaoCss=" style=\""height: 100%; width: 100%; border: 0 px;\"" "
else
if xmltype=1 then ''
strSourceFile1 = Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML1.load(strSourceFile1) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADxslei1=xml1.childNodes.item(16).text
ADcss1=xml1.childNodes.item(17).text
Set xml1=nothing
Set objXML1 =nothing
else
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,1,1
if not tempRs.eof then
ADcss1 = tempRs(17)
ADxslei1= tempRs(16)
end if
tempRs.close
Set tempRs=nothing
end if
gao1=PubFgdy(ADcss1,",",0)
kuan1=PubFgdy(ADcss1,",",1)
if PubFgdy(ADcss1,",",1)="" or ADxslei1="wb" then kuan1="100%"
if PubFgdy(ADcss1,",",0)="" or ADxslei1="wb" then gao1="100%"
GgtiaoCss=" style=\""height: "&gao1&"; width: "&kuan1&";border: "&PubFgdy(ADcss1,",",2)&"px solid "&PubFgdy(ADcss1,",",3)&";\"" "
end if
End Function
'/********************************************************************
' GgtiaoXs(id) 广告条显示过程 参数：id 广告条iD
'********************************************************************/
Sub GgtiaoXs(id)
dim tempxsnr
if isnumeric(id)=false then exit sub
if xmltype=1 then ''
strSourceFile = Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML.load(strSourceFile) '把XML文件读入内存
Set xml=objXML.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADid=xml.childNodes.item(0).text
ADname=xml.childNodes.item(1).text
ADintro=xml.childNodes.item(2).text
ADact=xml.childNodes.item(3).text
ADclass=xml.childNodes.item(4).text
Pids=xml.childNodes.item(5).text
Picid=xml.childNodes.item(6).text
ADurl=xml.childNodes.item(7).text
ADwindow=xml.childNodes.item(8).text
ADshow=xml.childNodes.item(9).text
ADshows=xml.childNodes.item(10).text
ADclick=xml.childNodes.item(11).text
ADclicks=xml.childNodes.item(12).text
ADtime=xml.childNodes.item(13).text
ADstoptime=xml.childNodes.item(14).text
ADstarttime=xml.childNodes.item(15).text
ADxslei=xml.childNodes.item(16).text
ADcss=xml.childNodes.item(17).text
Picurl=xml.childNodes.item(18).text
ADipkg=xml.childNodes.item(19).text
xml.childNodes.item(9).text=xml.childNodes.item(9).text+1 '' 显示次数加 1
objXML.save(strSourceFile)
Set xml=nothing
Set objXML =nothing
if ADipkg="1" then '' 如果 ip 开关打开
Getip=request.ServerVariables("REMOTE_ADDR")
Call GgtiaoIp(ADid,Getip,dataxml&"/Advertisement/"&ADid&"/ip1.xml") '' 新增浏览 ip 记录
end if
else '' 从数据库取
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,3,3,1
if not tempRs.eof then
ADid=tempRs(0)
ADname=tempRs(1)
ADintro=tempRs(2)
ADact=tempRs(3)
ADclass=tempRs(4)
Pids=tempRs(5)
Picid=tempRs(6)
ADurl=tempRs(7)
ADwindow=tempRs(8)
ADshow=tempRs(9)
ADshows=tempRs(10)
ADclick=tempRs(11)
ADclicks=tempRs(12)
ADtime=tempRs(13)
ADstoptime=tempRs(14)
ADstarttime=tempRs(15)
ADxslei=tempRs(16)
ADcss=tempRs(17)
Picurl=tempRs(18)
ADipkg=tempRs(19)
tempRs(9)=tempRs(9)+1 '' 显示次数加 1
tempRs.update
end if
tempRs.close
if ADipkg="1" then '' 如果 ip 开关打开
Getip=request.ServerVariables("REMOTE_ADDR")
tempRs.open "select * from IP1 where ADid="&id,conn,3,3,1
tempRs.addnew
tempRs(1)=id
tempRs(2)=now()
tempRs(3)=Getip
tempRs.update
tempRs.close
end if
Set tempRs=nothing
end if
Select Case ADxslei
Case "tp"
styles="style='height:"&PubFgdy(ADcss,",",0)&"; width:"&PubFgdy(ADcss,",",1)&";border: "&PubFgdy(ADcss,",",2)&"px solid "&PubFgdy(ADcss,",",3)&";' "
tempxsnr = tempxsnr & "<a title='"&ADname&"' href='url.asp?id="&ADid&"&url="&ADurl&"' target='"&ADwindow&"'>"&"<img art='"&ADname&"' border=0 src='"&Picurl&"' "&styles&"></a>"
Case "dh"
styles="style='height:"&PubFgdy(ADcss,",",0)&"; width:"&PubFgdy(ADcss,",",1)&";border: "&PubFgdy(ADcss,",",2)&"px solid "&PubFgdy(ADcss,",",3)&";' "
'tempxsnr = tempxsnr & "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http:/download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0'; "&styles&"><param name=movie value='"&Picurl&"'><param name=quality value=high>"
tempxsnr = tempxsnr & "<embed src='"&Picurl&"' quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' "&styles&"></embed>"'</object>"
Case "dm"
styles="style='height:"&PubFgdy(ADcss,",",0)&"; width:"&PubFgdy(ADcss,",",1)&";border: "&PubFgdy(ADcss,",",2)&"px solid "&PubFgdy(ADcss,",",3)&";' "
tempxsnr = tempxsnr & "<iframe marginwidth=0 marginheight=0 frameborder=0 scrolling=no name='忠网广告系统 http://gg.zon.cn' src='GGtiaoDm.asp?id="&ADid&"' "&styles&"></iframe>"
Case "wy"
styles="style='height:"&PubFgdy(ADcss,",",0)&"; width:"&PubFgdy(ADcss,",",1)&";border: "&PubFgdy(ADcss,",",2)&"px solid "&PubFgdy(ADcss,",",3)&";' "
tempxsnr = tempxsnr & "<iframe align=center marginwidth=0 marginheight=0 frameborder=0 scrolling=no name='忠网广告系统 http://gg.zon.cn' src='"&ADintro&"' "&styles&"></iframe>" 'GGtiaoWy.asp?id="&ADid&"&u=
Case else
if PubFgdy(ADcss,",",7)="yes" then ADintro="<strong>"&ADintro&"</strong>"
if PubFgdy(ADcss,",",8)="yes" then ADintro="<em>"&ADintro&"</em>"
if PubFgdy(ADcss,",",9)="yes" then ADintro="<u>"&ADintro&"</u>"
ADintro="<font size='"&PubFgdy(ADcss,",",5)&"' face='"&PubFgdy(ADcss,",",4)&"' color='"&PubFgdy(ADcss,",",6)&"'>"&ADintro&"</font>"
tempxsnr = tempxsnr & "<a title='"&ADname&"' href='url.asp?id="&ADid&"&url="&ADurl&"' target='"&ADwindow&"' style='link:"&PubFgdy(ADcss,",",6)&"; visited:'"&PubFgdy(ADcss,",",7)&"; hover:"&PubFgdy(ADcss,",",8)&"'>"&ADintro&"</a>"
end Select
response.write "<script>document.write(unescape("""&escape(tempxsnr)&"""));</script>"
End Sub
'/********************************************************************
' GgtiaoXsName(id) 带预览连接的广告条名称显示过程 参数：id 广告条iD
'********************************************************************/
Sub GgtiaoXsName(id)
if isnumeric(id)=false then exit sub
strSourceFile = Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")
if xmltype=1 then ''
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML.load(strSourceFile) '把XML文件读入内存
Set xml=objXML.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADid=xml.childNodes.item(0).text
ADname=xml.childNodes.item(1).text
Set xml=nothing
Set objXML =nothing
else ''
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,3,3,1
if not tempRs.eof then
ADid=tempRs(0)
ADname=tempRs(1)
end if
tempRs.close
Set tempRs=nothing
end if
response.write ""&ADname&" <font class=red>ID="&ADid&"</font> [<a href=javascript:opw('GGtiaoCz.asp?a=Yl&id="&ADid&"','ZonGG"&ADid&"',800,600)>预览</a>] "
response.write "<br><br><font class=red><i>"&ADname&"</i></font>"
end Sub
'/********************************************************************
' GgtiaoXsSl(id) 广告条缩略显示过程 参数：id 广告条iD 不做任何计数
'********************************************************************/
Sub GgtiaoXsSl(id)
if isnumeric(id)=false then exit sub
if xmltype=1 then ''
strSourceFile = Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML.load(strSourceFile) '把XML文件读入内存
Set xml=objXML.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
ADid=xml.childNodes.item(0).text
ADname=xml.childNodes.item(1).text
ADintro=xml.childNodes.item(2).text
ADact=xml.childNodes.item(3).text
ADclass=xml.childNodes.item(4).text
Pids=xml.childNodes.item(5).text
Picid=xml.childNodes.item(6).text
ADurl=xml.childNodes.item(7).text
ADwindow=xml.childNodes.item(8).text
ADshow=xml.childNodes.item(9).text
ADshows=xml.childNodes.item(10).text
ADclick=xml.childNodes.item(11).text
ADclicks=xml.childNodes.item(12).text
ADtime=xml.childNodes.item(13).text
ADstoptime=xml.childNodes.item(14).text
ADstarttime=xml.childNodes.item(15).text
ADxslei=xml.childNodes.item(16).text
ADcss=xml.childNodes.item(17).text
Picurl=xml.childNodes.item(18).text
ADipkg=xml.childNodes.item(19).text
Set xml=nothing
Set objXML =nothing
else '''
Set tempRs=Server.CreateObject("ADODB.Recordset")
tempRs.open "select * from Advertisement where ADid="&id,conn,3,3,1
if not tempRs.eof then
ADid=tempRs(0)
ADname=tempRs(1)
ADintro=tempRs(2)
ADact=tempRs(3)
ADclass=tempRs(4)
Pids=tempRs(5)
Picid=tempRs(6)
ADurl=tempRs(7)
ADwindow=tempRs(8)
ADshow=tempRs(9)
ADshows=tempRs(10)
ADclick=tempRs(11)
ADclicks=tempRs(12)
ADtime=tempRs(13)
ADstoptime=tempRs(14)
ADstarttime=tempRs(15)
ADxslei=tempRs(16)
ADcss=tempRs(17)
Picurl=tempRs(18)
ADipkg=tempRs(19)
end if
tempRs.close
Set tempRs=nothing
end if
Select Case ADxslei
Case "tp"
styles="style='height:90; width:120;border: 1px solid "&PubFgdy(ADcss,",",3)&";' "
response.write "<a title='"&ADname&"' href='url.asp?id="&ADid&"&url="&ADurl&"' target='"&ADwindow&"'>"&"<img art='"&ADname&"' border=0 src='"&Picurl&"' "&styles&"></a>"
Case "dh"
styles="style='height:90; width:120;border: "&PubFgdy(ADcss,",",2)&"px solid "&PubFgdy(ADcss,",",3)&";' "
'response.write "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http:/download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0'; "&styles&"><param name=movie value='"&Picurl&"'><param name=quality value=high>"
response.write "<embed src='"&Picurl&"' quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' "&styles&"></embed>"'</object>"
Case "dm"
styles="style='height:90; width:120;border: 1px solid "&PubFgdy(ADcss,",",3)&";' "
response.write "<iframe marginwidth=0 marginheight=0 frameborder=0 scrolling=no name='忠网广告系统 http://gg.zon.cn' src='GGtiaoDm.asp?id="&ADid&"' "&styles&"></iframe>"
Case "wy"
styles="style='height:90; width:120;border: 1px solid "&PubFgdy(ADcss,",",3)&";' "
response.write "<iframe align=center marginwidth=0 marginheight=0 frameborder=0 scrolling=no name='忠网广告系统 http://gg.zon.cn' src='"&ADintro&"' "&styles&"></iframe>" 'GGtiaoWy.asp?id="&ADid&"&u=
Case else
if PubFgdy(ADcss,",",7)="yes" then ADintro="<strong>"&ADintro&"</strong>"
if PubFgdy(ADcss,",",8)="yes" then ADintro="<em>"&ADintro&"</em>"
if PubFgdy(ADcss,",",9)="yes" then ADintro="<u>"&ADintro&"</u>"
ADintro="<font size='"&PubFgdy(ADcss,",",5)&"' face='"&PubFgdy(ADcss,",",4)&"' color='"&PubFgdy(ADcss,",",6)&"'>"&ADintro&"</font>"
response.write "<a title='"&ADname&"' href='url.asp?id="&ADid&"&url="&ADurl&"' target='"&ADwindow&"'>"&ADintro&"</a>"
end Select
End Sub
'/********************************************************************
' GgtiaoIp(aid,ip,file) 新增IP记录 参数：aid 广告条编号,ip 客户ip、file ip数据文件名 适用于 xml 存取数据
'********************************************************************/
Sub GgtiaoIp(aid,ip,file)
Dim fso
Dim brstr:brstr=chr(13)&chr(10)&chr(9) '规范 XML 样式
if ip<>"" and file<>"" then
file=Server.MapPath(file) '获取XML文件的路径这里根据虚拟目录不同而不同
Set fso = server.CreateObject("Scripting.FileSystemObject")
if fso.FileExists(file) then '如果文件存在，则继续 ...
Dim strSourceFile,objXML,objRootsite,XMLnode,ipid,AllNodesNum
strSourceFile = file
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML.load(strSourceFile) '把XML文件读入内存
Set objRootsite = objXML.documentElement.selectSingleNode("ips")
AllNodesNum =objRootsite.childNodes.length
if AllNodesNum>0 then
ipid = objRootsite.lastchild.firstchild.text+1
else
ipid =1
end if
'根据得到的数据循环个节点名、值建立XML片段
XMLnode=chr(9)&brstr&"<IP>"&_
brstr&"<IPid>"&ipid&"</IPid>"&_
brstr&"<ADid>"&aid&"</ADid>"&_
brstr&"<IPtime>"&now()&"</IPtime>"&_
brstr&"<IPaddress>"&ip&"</IPaddress>"&_
brstr&"</IP>"&chr(9)
Dim objXML2,rootNewNode
set objXML2=Server.CreateObject("Microsoft.XMLDOM") '建立一个新XML对像
objXML2.loadXML(XMLnode) '把XML版片段读入内存中
set rootNewNode=objXML2.documentElement '获得objXML2的根节点
objRootsite.appendChild(rootNewNode) '把XML片段插入
objXML.save(strSourceFile)
Set objXML =nothing
'' 释放 fso
Set fso = nothing
end if
end if
End Sub
'/********************************************************************
' GgtiaoXsAct1(tiaos) 从若干广告条列表中取出正常广告条列表 参数：tiaos 原广告条列表 用 “,”分隔
'********************************************************************/
Function GgtiaoXsAct1(tiaos)
Dim tiaosi,tiaoss,objXML1,xml1,act1
tiaoss=split(tiaos&",",",")
GgtiaoXsAct1=""
if xmltype=1 then ''
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
for tiaosi=0 to Ubound(tiaoss)-1
if isnumeric(tiaoss(tiaosi))=true then
objXML1.load( Server.MapPath(dataxml&"/Advertisement/"&tiaoss(tiaosi)&"/adv.xml")) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
act1=xml1.childNodes.item(3).text
Set xml1=nothing
if act1="1" then
if GgtiaoXsAct1="" then
GgtiaoXsAct1=tiaoss(tiaosi)
else
GgtiaoXsAct1=GgtiaoXsAct1&","&tiaoss(tiaosi)
end if
end if
end if
next
Set objXML1 =nothing
else '''
Set tempRs=Server.CreateObject("ADODB.Recordset")
for tiaosi=0 to Ubound(tiaoss)-1
if isnumeric(tiaoss(tiaosi))=true then
tempRs.open "select * from Advertisement where ADid="&tiaoss(tiaosi)&" and ADact=1 ",conn,3,3,1
if not tempRs.eof then
if GgtiaoXsAct1="" then
GgtiaoXsAct1=tiaoss(tiaosi)
else
GgtiaoXsAct1=GgtiaoXsAct1&","&tiaoss(tiaosi)
end if
end if
tempRs.close
end if
next
Set tempRs=nothing
end if
End Function
'//********************************************************************
' GgtiaoXsAct2(tiaos) 从若干广告条列表中取出非正常广告条列表 参数：tiaos 原广告条列表 用 “,”分隔
'********************************************************************//
Function GgtiaoXsAct2(tiaos)
Dim tiaosi,tiaoss,objXML1,xml1,act1
tiaoss=split(tiaos&",",",")
GgtiaoXsAct2=""
if xmltype=1 then ''
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
for tiaosi=0 to Ubound(tiaoss)-1
if isnumeric(tiaoss(tiaosi))=true then
objXML1.load( Server.MapPath(dataxml&"/Advertisement/"&tiaoss(tiaosi)&"/adv.xml")) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
act1=xml1.childNodes.item(3).text
Set xml1=nothing
if act1<>"1" then
if GgtiaoXsAct2="" then
GgtiaoXsAct2=tiaoss(tiaosi)
else
GgtiaoXsAct2=GgtiaoXsAct2&","&tiaoss(tiaosi)
end if
end if
end if
next
Set objXML1 =nothing
else '''
Set tempRs=Server.CreateObject("ADODB.Recordset")
for tiaosi=0 to Ubound(tiaoss)-1
if isnumeric(tiaoss(tiaosi))=true then
tempRs.open "select * from Advertisement where ADid="&tiaoss(tiaosi)&" and ADact<>1 ",conn,3,3,1
if not tempRs.eof then
if GgtiaoXsAct1="" then
GgtiaoXsAct1=tiaoss(tiaosi)
else
GgtiaoXsAct1=GgtiaoXsAct1&","&tiaoss(tiaosi)
end if
end if
tempRs.close
end if
next
Set tempRs=nothing
end if
End Function
'//********************************************************************
' GgtiaoPids(id) 取出广告条的广告位 id 列表 参数：id 广告条 id
'********************************************************************//
Function GgtiaoPids(id)
GgtiaoPids=""
if xmltype=1 then ''
Dim objXML1,xml1
Set objXML1 =Server.CreateObject("Microsoft.XMLDOM") '创建一个XML对像
objXML1.load( Server.MapPath(dataxml&"/Advertisement/"&id&"/adv.xml")) '把XML文件读入内存
Set xml1=objXML1.documentElement.selectSingleNode("Advertisement") '选取节点 Advertisement
GgtiaoPids=xml1.childNodes.item(5).text
Set objXML1 =nothing
else '''
Set tempRs=Server.CreateObject("ADODB.Recordset")
for tiaosi=0 to Ubound(tiaoss)-1
if isnumeric(tiaoss(tiaosi))=true then
tempRs.open "select * from Advertisement where ADid="&id&" ",conn,3,3,1
if not tempRs.eof then
GgtiaoPids= tempRs(5)
end if
tempRs.close
end if
next
Set tempRs=nothing
end if
End Function
'//********************************************************************
' PicNewRuku(gif_url) 新增广告条图片入库函数同时返回新增图片的 ID 号,自动监测是否已存在，如果存在，则不做新增直接返回 ID 参数：gif_url 图片地址，
'********************************************************************//
Function PicNewRuku(gif_url)
PicNewRuku=0
if Len(Trim(gif_url))>7 and Instr(Trim(gif_url),".")>0 Then '判断图片地址是否有效
Set RsLs=Server.CreateObject("ADODB.Recordset")
RsLs.Open "Select * from [Pictrue] where PicUrl like '"&gif_url&"' order by Picid",conn,3,3,1
if not RsLs.eof then
else
RsLs.Addnew:Rsls(1)=gif_url:RsLs.update
if xmltype=1 then ''
call PubNewXml(dataxml&"/pictrue.xml","Pictrue","Picid|Picurl",RsLs(0)&"/$/"&RsLs(1),"Pic") '' 新增图片信息到 Picture.xml 数据流
end if
end if
PicNewRuku=RsLs(0):RsLs.Close
Set RsLs=Nothing
end if
End Function
'/********************************************************************
' PicDel(picid) 删除广告图片记录函数 参数：picid 广告图ID，
'********************************************************************/
Sub PicDel(picid)
if isnumeric(picid) then
conn.execute("delete from Pictrue where Picid="&picid)
end if
End Sub
'/********************************************************************
' PicOldRuku(gif_url,Picid) 修改广告条图片入库过程 不返回任何值，参数：gif_url 图片地址，Picid 图片库存编号
'********************************************************************/
Sub PicOldRuku(gif_url,Picid)
if Len(Trim(gif_url))>4 and Lcase(Trim(gif_url))<>"http://" Then '判断图片地址是否有效
if isnumeric(Picid)=false Then Picid=0 '判断该广告条图片ID是否为数字 否则 设为 0
Set RsLs=Server.CreateObject("ADODB.Recordset")
RsLs.Open "Select * from Pictrue where Picid="&cint(Picid),conn,3,3,1
If not RsLs.eof then RsLs.Addnew '判断该广告条图片是否存在 如果存在则直接修改之（如果该图片为上传图片，则继续保留），如不存在新增
Rsls(1)=gif_url:RsLs.update:RsLs.Close
Set RsLs=Nothing
end if
End Sub
'//********************************************************************
' Ggdklx(lx) 广告条连接打开类型名函数 参数：lx 数字
'********************************************************************//
Function Ggdklx(lx)
Select Case lx
Case 0:Ggdklx="新窗口"
Case else:Ggdklx="本窗口"
End select
End Function
'//********************************************************************
' Ggxslx(lx) 广告条显示类型名函数 参数：lx tp--图片、wb--文本、dh--动画、dm--代码
'********************************************************************//
Function Ggxslx(lx)
Select Case lx
Case "tp"
Ggxslx="图片"
Case "wb"
Ggxslx="纯文本"
Case "dh"
Ggxslx="动画"
Case "dm"
Ggxslx="嵌入代码"
Case "wy"
Ggxslx="植入网页"
End select
End Function
'//********************************************************************
' Ggflm(cid) 分类名称调用 参数：cid 分类编号
'********************************************************************//
Function Ggflm(cid)
Ggflm=""
If isnumeric(cid) Then
set RsLs=server.createobject("adodb.recordset")
RsLs.open "select Cname from Class where Cid="&cid,conn,1,1
if not RsLs.eof then
Ggflm=RsLs(0)
else
Ggflm=""
end if
RsLs.close
Set RsLs=nothing
End if
End Function
'//********************************************************************
' GgPlaceflid(pid) 某广告位所属分类id调用 参数：pid 广告位id编号
'********************************************************************//
Function GgPlaceflid(pid)
GgPlaceflid=0
If isnumeric(pid) Then
set RsLs=server.createobject("adodb.recordset")
RsLs.open "select cid from Place where pid="&pid,conn,1,1
if not RsLs.eof then
GgPlaceflid=RsLs(0)
else
GgPlaceflid=0
end if
RsLs.close
Set RsLs=nothing
End if
End Function
'//********************************************************************
' Ggwm(place) 广告位名称调用 参数：place 广告位编号
'********************************************************************//
Function Ggwm(place)
cid=0
If isnumeric(place) Then
set RsLs=server.createobject("adodb.recordset")
RsLs.open "select Pname,cid from Place where Pid="&place,conn,1,1
if not RsLs.eof then
Ggwm=RsLs(0)
cid=RsLs(1)
else
Ggwm=""
end if
RsLs.close
if cid<>0 then
RsLs.open "select cname from Class where cid="&cid,conn,1,1
if not RsLs.eof then
Ggwm=RsLs(0)&" <font class=red>>></font> "&Ggwm
end if
RsLs.close
end if
Set RsLs=nothing
End if
End Function
'//********************************************************************
' Ggwlxsz(place) 某广告位类型标示数字调用 参数：place 广告位编号
'********************************************************************//
Function Ggwlxsz(place)
set RsLs=server.createobject("adodb.recordset")
RsLs.open "select * from place where Pid="&place,conn,1,1
if not RsLs.eof then
Ggwlxsz=RsLs(2)
else
Ggwlxsz=0
end if
RsLs.close
Set RsLs=nothing
End Function
'//********************************************************************
' Ggwlx(place) 广告位类型名称调用 参数：place 广告位编号
'********************************************************************//
Function Ggwlx(place)
set RsLs=server.createobject("adodb.recordset")
RsLs.open "select * from place where Pid="&place,conn,1,1
if not RsLs.eof then
Ggwlx=RsLs(2)
Ggwlx=PubFgdy(Ggweilx,"|",Ggwlx)
else
Ggwlx="广告位被删除"
end if
RsLs.close
Set RsLs=nothing
End Function
'//********************************************************************
' FhjjCode(shu) 行间距调用 参数：shu 高度 数字
'********************************************************************//
Function FhjjCode(shu)
FhjjCode="<table border='0' width='100%' cellpadding='0' style='border-collapse: collapse' height='"&shu&"'><tr><td></td></td></tr></table>"
End Function
'//********************************************************************
' FljjCode(shu) 列间距调用 参数：shu 宽度 数字
'********************************************************************//
Function FljjCode(shu)
FljjCode="<td width='"&shu&"'></td>"
End Function
%>